home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 001_100 / disk0091 / globe.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-10-25  |  3.1 KB  |  113 lines
  1. 10  'Real Time Perspective Image of Rotated Globe
  2. 20  '
  3. 30  'Original program by: Karl Koessel
  4. 40  '
  5. 50  'Animation by: Andrew Tuline
  6. 60  '
  7. 70  'This program has been modified from the original submitted to
  8. 80  'PCWORLD magazine. The initialization draws 5 different images
  9. 90  'and stores the array for each image to disk. This process requires
  10. 100  'about 15 minutes. The data file GLOBE.DAT is stored to disk.
  11. 110  'The program checks for this data file, and if not available, will
  12. 120  'create one. Once this file has been created, the program will load
  13. 130  'it into the corresponding arrays, and will display a realtime rotating
  14. 140  'globe in the Screen 2 mode. The globe occupies a small section of the
  15. 150  'screen and shows best results when used with an RGB monitor. This seems
  16. 160  'a good example of non-flickering graphics in Basic.
  17. 170  '
  18. 180  '
  19. 190  SCREEN 2:CLS:KEY OFF:DEFINT L,R,X-Z
  20. 200  DIM RC(11),A%(380),B%(380),C%(380),D%(380),E%(380)
  21. 210  ON ERROR GOTO 1100
  22. 220  OPEN "GLOBE.DAT" FOR INPUT AS #1
  23. 230  FOR I=0 TO 380:INPUT #1,A%(I):NEXT
  24. 240  FOR I=0 TO 380:INPUT #1,B%(I):NEXT
  25. 250  FOR I=0 TO 380:INPUT #1,C%(I):NEXT
  26. 260  FOR I=0 TO 380:INPUT #1,D%(I):NEXT
  27. 270  FOR I=0 TO 380:INPUT #1,E%(I):NEXT
  28. 275  CLS
  29. 280  PUT (320,100),A%,PSET
  30. 290  PUT (320,100),B%,PSET
  31. 300  PUT (320,100),C%,PSET
  32. 310  PUT (320,100),D%,PSET
  33. 320  PUT (320,100),E%,PSET
  34. 330  A$=INKEY$:IF A$="" THEN 280 ELSE END
  35. 340  OPEN "GLOBE.DAT" FOR OUTPUT AS #1
  36. 350  CX=CY:CZ=SX:SY=SZ:I=J:R=A:B=C:A1=B2:C1=C2
  37. 360  A3=B3:X=Y:XC=YC:LX=LY:B$=C$:RC=PI:LZ=ZS:Q=DR
  38. 370  FOR X=1 TO 11
  39. 380       RC(X)=(X-1)MOD 3+1
  40. 390      IF X>6 THEN RC(X)=(5-RC(X))MOD 3+1
  41. 400  NEXT
  42. 410  PI=3.14159
  43. 420  CF=PI/180
  44. 430  GOSUB 1030
  45. 440  FOR YROT=120 TO 132 STEP 3
  46. 450  GOSUB 530
  47. 460  GET (265,73)-(373,126),A%
  48. 470  FOR I=0 TO 380:PRINT #1,A%(I):NEXT
  49. 480  NEXT
  50. 490  BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP
  51. 500  CLOSE #1
  52. 510  A$=INKEY$:IF A$<>"" THEN 510
  53. 520  GOTO 220
  54. 530  CX=COS(CF*XROT+ATN(YOBS/ZOBS)):SX=SIN(CF*XROT+ATN(YOBS/ZOBS))
  55. 540  CY=COS(CF*YROT+ATN(XOBS/ZOBS)):SY=SIN(CF*YROT+ATN(XOBS/ZOBS))
  56. 550  CZ=COS(CF*ZROT):SZ=SIN(CF*ZROT)
  57. 560  ZOBS=SQR(XOBS^2+YOBS^2+ZOBS^2)
  58. 570  ZS=R^2/ZOBS
  59. 580  CLS
  60. 590  LOCATE 1,1:PRINT"Initializing GLOBE.DAT. 5 beeps will sound upon completion"591
  61. 600  LOCATE 5,5:PRINT USING "Picture # of 5";(YROT-117)/3
  62. 610  FOR I=0 TO 3 STEP PI/12
  63. 620      RC=(I*12/PI+2)MOD 3+1
  64. 630      C$=STR$(RC)
  65. 640      C$="3"
  66. 650      FOR J=0 TO 2.0001*PI STEP PI/24
  67. 660              A=R*SIN(I)*SIN(J)
  68. 670              B=R*COS(J)
  69. 680              C=R*COS(I)*SIN(J)
  70. 690              GOSUB 860
  71. 700              GOSUB 960
  72. 710      NEXT
  73. 720  NEXT
  74. 730  FOR I=PI/12 TO 11*PI/12 STEP PI/12
  75. 740      RC=RC(I*12/PI)
  76. 750      C$=STR$(RC)
  77. 760      C$="3"
  78. 770      FOR J=0 TO 2.0001*PI STEP PI/24
  79. 780              A=R*SIN(I)*SIN(J)
  80. 790              B=R*COS(I)
  81. 800              C=R*SIN(I)*COS(J)
  82. 810              GOSUB   860
  83. 820              GOSUB 960
  84. 830      NEXT
  85. 840  NEXT
  86. 850  RETURN
  87. 860  A1=A*CY-C*SY
  88. 870  C1=A*SY+C*CY
  89. 880  B2=B*CX-C1*SX
  90. 890  C2=B*SX+C1*CX
  91. 900  A3=A1*CZ-B2*SZ
  92. 910  B3=A1*SZ+B2*CZ
  93. 920  DR=C2/(ZOBS-C2)+1
  94. 930  X=INT(A3*DR*ASP+XC)
  95. 940  Y=INT(B3*-DR+YC)
  96. 950  RETURN
  97. 960  IF C2<ZS OR LZ<ZS THEN B$="BC":GOTO 990
  98. 970  Q=(X<0)+(X>639)+(Y<0)+(Y>199)+(LX<0)+(LX>639)+(LY<0)+(LY>199)
  99. 980  IF Q+(J=0) THEN B$="BC" ELSE B$="C"
  100. 990  LX=X:LY=Y
  101. 1000  LZ=C2
  102. 1010  DRAW B$+C$+"M"+STR$(X)+","+STR$(Y)
  103. 1020  RETURN
  104. 1030  XC=320:YC=100
  105. 1040  XOBS=-9:YOBS=0:ZOBS=456
  106. 1050  XROT=37:ZROT=23:'YROT=-123
  107. 1060  R=25
  108. 1070  BCK=1:PAL=1
  109. 1080  ASP=2
  110. 1090  RETURN
  111. 1100  IF ERR<>53 THEN PRINT"error":END
  112. 1110  RESUME 340
  113.